home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok22.lha / Stardance / StarDance.MOD < prev    next >
Text File  |  1993-08-15  |  7KB  |  288 lines
  1. (*******************************************************************************
  2.  :Program.         StarDance.MOD
  3.  :Author.          André Theiler und Carsten Wartmann
  4.  :Address.         Wutzkyallee 83, D-1000 Berlin 47 (C.W.)
  5.  :Phone.           030/6614776
  6.  :Version.         1.5  (1.0)
  7.  :Date.            6/89 (4/89)
  8.  :Copyright.       PD
  9.  :Language.        Modula-2
  10.  :Compiler.        M2Amiga V3.2d
  11.  :Contents.        Simulation des Sonnensystems
  12. *******************************************************************************)
  13.  
  14. (* For more info see StarDance.DOC *)
  15.  
  16. MODULE StarDance ;
  17.  
  18. FROM SYSTEM       IMPORT BITSET,ADR,FFP,ADDRESS,INLINE ;
  19.  
  20. FROM Arts         IMPORT Assert ;
  21.  
  22. FROM Intuition    IMPORT NewScreen,ScreenPtr,OpenScreen,CloseScreen,
  23.                          customScreen,NewWindow,WindowPtr,
  24.                          IDCMPFlags,IDCMPFlagSet,WindowFlags,WindowFlagSet,
  25.                          OpenWindow,CloseWindow ;
  26.  
  27. FROM Graphics     IMPORT ViewModes,ViewModeSet,SetAPen,RastPortPtr,ClearScreen,
  28.                          SetRGB4,AreaMove,AreaDraw,AreaEnd,AllocRaster,Move,
  29.                          FreeRaster,InitArea,TmpRas,AreaInfo,InitTmpRas,
  30.                          RastPort,LoadRGB4,WritePixel,Draw ;
  31.  
  32. FROM MathLib0     IMPORT sqrt ;
  33.  
  34. FROM FileSystem   IMPORT File,Response,Lookup,Close,ReadChar ;
  35.  
  36. FROM Str          IMPORT Concat ;
  37.  
  38. FROM RealConversions IMPORT StrToReal ;
  39.  
  40.  
  41. VAR screen                  : NewScreen ;
  42.     screenptr               : ScreenPtr ;
  43.     window                  : NewWindow ;
  44.     windowptr               : WindowPtr ;
  45.     drawRP                  : RastPortPtr ;
  46.     viewP                   : ADDRESS ;
  47.     cia[0BFE000H]           : BITSET ;
  48.     sternmax                : INTEGER ;
  49.     zoom,deltat,f           : REAL ;
  50.     x,y,z,masse,
  51.     vx,vy,vz                : ARRAY [0..20] OF REAL ;
  52.  
  53.  
  54.  
  55. PROCEDURE RGB ; (*$E-*)
  56.  
  57.    BEGIN (* Farbwerte der Objekte *)
  58.  
  59.       INLINE(
  60.              0000H,0F00H,0F80H,0FF0H,000FH,0F0FH,00FFH,00F0H,
  61.              0FFFH,0777H,0F50H,05F0H,04C0H,03D0H,02E0H,01F0H
  62.             ) ;
  63.  
  64. END RGB ;
  65.  
  66.  
  67. PROCEDURE ExtData() ;
  68.  
  69. VAR data        : File ;
  70.     stern       : INTEGER ;
  71.     wert        : REAL ;
  72.     zeichen     : CHAR ;
  73.     zahlstr     : ARRAY [0..30] OF CHAR ;
  74.     einstr      : ARRAY [0..1]  OF CHAR ;
  75.     err,ende    : BOOLEAN ;
  76.  
  77. PROCEDURE ReadData() : REAL ;
  78.  
  79.    BEGIN (* Lesen eines Wertes *)
  80.  
  81.       LOOP
  82.  
  83.          ReadChar(data,zeichen) ;
  84.  
  85.          IF data.eof OR (data.res # done) THEN
  86.             ende := TRUE ;
  87.             RETURN (1.0);
  88.          END ;
  89.  
  90.          IF (zeichen = "#") THEN
  91.             EXIT ;
  92.          END ;
  93.  
  94.       END (*LOOP*) ;
  95.  
  96.          zahlstr := "" ;
  97.          einstr  := " " ;
  98.  
  99.          ReadChar(data,zeichen) ;
  100.  
  101.          REPEAT
  102.  
  103.             einstr[0] := zeichen ;
  104.             Concat(zahlstr,einstr) ;
  105.             ReadChar(data,zeichen) ;
  106.  
  107.          UNTIL (zeichen = "!") ;
  108.  
  109.          StrToReal(zahlstr,wert,err) ;
  110.          Assert(err#TRUE,ADR("Syntax Error im Datenfile !")) ;
  111.  
  112.          RETURN(wert) ;
  113.  
  114. END ReadData ;
  115.  
  116.    BEGIN (* ExtData *)
  117.  
  118.       Lookup(data,"StarDance.DAT",1024,FALSE) ;
  119.       Assert(data.res=done,ADR("Lookup misslungen")) ;
  120.  
  121.       sternmax := TRUNC(ReadData()) ;
  122.       f        := ReadData() ;
  123.       zoom     := ReadData() ;
  124.       deltat   := ReadData() ;
  125.  
  126.       stern    := 0 ;
  127.  
  128.       WHILE (stern < sternmax) AND (ende = FALSE) DO
  129.  
  130.          x[stern]     := ReadData() ;
  131.          y[stern]     := ReadData() ;
  132.          z[stern]     := ReadData() ;
  133.          vx[stern]    := ReadData() ;
  134.          vy[stern]    := ReadData() ;
  135.          vz[stern]    := ReadData() ;
  136.          masse[stern] := ReadData() ;
  137.  
  138.          IF (ReadData()#0.0) THEN
  139.             INC(stern) ;
  140.          ELSE
  141.             DEC(sternmax) ;
  142.          END ;
  143.  
  144.       END (*WHILE*) ;
  145.  
  146.       Close(data) ;
  147.  
  148. END ExtData ;
  149.  
  150.  
  151. PROCEDURE OpenAll ;
  152.  
  153.    BEGIN (* Öffnen des Screens und Windows *)
  154.  
  155.       WITH screen DO
  156.  
  157.          leftEdge     := 0 ;
  158.          topEdge      := 0 ;
  159.          width        := 640 ;
  160.          height       := 256 ;
  161.          depth        := 4 ;
  162.          viewModes    := ViewModeSet{hires} ;
  163.          type         := customScreen ;
  164.          font         := NIL ;
  165.          defaultTitle := NIL ;
  166.          gadgets      := NIL ;
  167.          customBitMap := NIL ;
  168.  
  169.       END (*WITH*) ;
  170.  
  171.       screenptr := OpenScreen(screen) ;
  172.       Assert(screenptr # NIL,ADR("Screen is nix")) ;
  173.  
  174.       WITH window DO
  175.  
  176.          leftEdge    := 0 ;
  177.          topEdge     := 0 ;
  178.          width       := 640 ;
  179.          height      := 256 ;
  180.          detailPen   := 0 ;
  181.          blockPen    := 1 ;
  182.          idcmpFlags  := IDCMPFlagSet{} ;
  183.          flags       := WindowFlagSet{borderless} ;
  184.          firstGadget := NIL ;
  185.          checkMark   := NIL ;
  186.          title       := NIL ;
  187.          screen      := screenptr ;
  188.          bitMap      := NIL ;
  189.          type        := customScreen ;
  190.  
  191.       END (*WITH*) ;
  192.  
  193.       windowptr := OpenWindow(window) ;
  194.       Assert(windowptr # NIL,ADR("Window is nix")) ;
  195.  
  196.       drawRP := windowptr^.rPort ;
  197.       viewP  := ADR(screenptr^.viewPort) ;
  198.  
  199.       LoadRGB4(viewP,ADR(RGB),16) ;
  200.  
  201. END OpenAll ;
  202.  
  203.  
  204. PROCEDURE Dance ;
  205.  
  206. VAR stern0,stern1,
  207.     xbild,ybild,
  208.     dummy            : INTEGER ;
  209.     ax,ay,az,
  210.     dx,dy,dz,
  211.     distanz,a        : REAL ;
  212.  
  213.    BEGIN (* Eigentliche Berechnung *)
  214.  
  215.  
  216.       WHILE (7 IN cia) DO (* Solange bis Joy-Knopf gedrückt *)
  217.  
  218.          stern0 := 0 ;
  219.  
  220.          WHILE (stern0 < sternmax) DO
  221.  
  222.             ax := 0.0 ;
  223.             ay := 0.0 ;
  224.             az := 0.0 ;
  225.  
  226.             stern1 := 0 ;
  227.  
  228.             WHILE (stern1 < sternmax) DO
  229.  
  230.                IF (stern0 # stern1) THEN
  231.  
  232.                   dx       := x[stern1] - x[stern0] ;
  233.                   dy       := y[stern1] - y[stern0] ;
  234.                   dz       := z[stern1] - z[stern0] ;
  235.  
  236.                   distanz  := sqrt(dx*dx + dy*dy + dz*dz) ;
  237.                   a        := f * masse[stern1] / (distanz*distanz) ;
  238.  
  239.                   ax       := ax + dx * a / distanz ;
  240.                   ay       := ay + dy * a / distanz ;
  241.                   az       := az + dz * a / distanz ;
  242.  
  243.                END (*IF*) ;
  244.  
  245.                INC(stern1) ;
  246.  
  247.             END (*WHILE stern1*) ;
  248.  
  249.             vx[stern0] := vx[stern0] + ax * deltat ;
  250.             vy[stern0] := vy[stern0] + ay * deltat ;
  251.             vz[stern0] := vz[stern0] + az * deltat ;
  252.  
  253.             x[stern0]  := x[stern0] + vx[stern0] * deltat ;
  254.             y[stern0]  := y[stern0] + vy[stern0] * deltat ;
  255.             z[stern0]  := z[stern0] + vz[stern0] * deltat ;
  256.  
  257.             xbild      := 320 + TRUNC(x[stern0] * zoom*2.0) ;
  258.             ybild      := 120 - TRUNC(y[stern0] * zoom) ;
  259.  
  260.             SetAPen(drawRP,stern0+1) ;
  261.             dummy      := WritePixel(drawRP,xbild,ybild) ;
  262.  
  263.             INC(stern0) ;
  264.  
  265.          END (*WHILE stern0*) ;
  266.  
  267.       END (*WHILE CIA*) ;
  268.  
  269. END Dance ;
  270.  
  271.  
  272. BEGIN (* Hauptprogramm StarDance *)
  273.  
  274.  
  275.    OpenAll ;
  276.  
  277.    ExtData ;
  278.  
  279.    Dance ;
  280.  
  281.    WHILE (6 IN cia) DO (* Bild ansehen bis Mausknopf gedrückt...*)
  282.    END (*WHILE*) ;
  283.  
  284.    CloseWindow(windowptr) ;  (* Alles zu *)
  285.    CloseScreen(screenptr) ;
  286.  
  287. END StarDance .
  288.